home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / fpkpas92.zip / SRCRTL.ZIP / RTL / DOS / TRIANGLE.PPI < prev    next >
Text File  |  1997-07-01  |  1KB  |  44 lines
  1. { FILE: TRIANGLE.PPI }
  2.  
  3. procedure Triangle(A,B,C:PointType);
  4.  
  5. var temp : PointType;
  6.     yc,yl    : Integer;
  7.     x1,x2,x3 : Integer;
  8.     y1,y2,y3 : Integer;
  9. begin
  10.   if B.Y < A.Y then begin Temp:=A; A:=B; B:=Temp; end;
  11.   if C.Y < B.Y then begin Temp:=B; B:=C; C:=Temp; end;
  12.   if B.Y < A.Y then begin Temp:=A; A:=B; B:=Temp; end;
  13.   x1:=b.x-a.x;  y1:=b.y-a.y;
  14.   x2:=c.x-b.x;  y2:=c.y-b.y;
  15.   x3:=c.x-a.x;  y3:=c.y-a.y;
  16.   yl:=b.y-a.y;
  17.   if y1 <> 0 then
  18.     for yc:=0 to y1 do
  19.     begin
  20.       patternline(a.x + yc * x1 div y1,a.x+ yc * x3 div y3,a.y+yc);
  21.     end;
  22.   if y2 <> 0 then
  23.     for yc:=0 to y2 do
  24.     begin
  25.       patternline(c.x - yc * x2 div y2,c.x - yc * x3 div y3,c.y-yc);
  26.     end;
  27. end;
  28.  
  29. procedure Filltriangle(A,B,C:PointType);
  30. begin
  31.   _graphresult:=grOK;
  32.   if not isgraphmode then
  33.   begin
  34.     _graphresult:=grnoinitgraph;
  35.     exit;
  36.   end;
  37.   Triangle(A,B,C);
  38.   if (aktcolor<>aktfillsettings.color) or (aktfillsettings.pattern<>1) then
  39.   begin
  40.     line(a.x,a.y,b.x,b.y);
  41.     line(b.x,b.y,c.x,c.y);
  42.     line(c.x,c.y,a.x,a.y);
  43.   end;
  44. end;